perm filename SHOW1.OSA[1,ALS] blob
sn#001124 filedate 1972-08-04 generic text, type T, neo UTF8
00010 BEGIN "SHOW"
00020 DEFINE ⊂="COMMENT"; ⊂ 7/26/72;
00030 ⊂ This is the master program for the use of signature tables in
00040 speech recognition. It calls on a number of other routines for
00050 much of the actual work but this program calls on the display
00060 routines and displays the output as well as making a record
00070 by means of the TELL routine;
00072 ⊂ When the program halts to allow time for viewing results it
00074 expects a space bar response, when it is requesting information
00076 this information must be terminated by a return key stroke;
00080
00090 REQUIRE "COMSUB.HDR[SYS,ALS]" SOURCE_FILE;
00100 REQUIRE "BLOCKS.HDR[SYS,THO]" SOURCE_FILE;
00110 REQUIRE "SIG1[1,ALS]" LOAD_MODULE;
00120 REQUIRE "DPYOLD.HDR[1,THO]" SOURCE_FILE;
00130 DEFINE DPYSIZ="1000";
00140 INTEGER DPPOINT,DPP1,DPP2,DATSHIFT;
00160 EXTERNAL FORTRAN PROCEDURE SIG(REFERENCE INTEGER P);
00170 EXTERNAL STRING PROCEDURE INCHWL;
00180 EXTERNAL PROCEDURE SPOOL(STRING S; INTEGER IOCHAN,FLAGS);
00200 DEFINE DATSIZ="1280",BUFEXS="43",BUFSIZ="1323";
00210 DEFINE BYTE="((ILDB(BPT) LSH 24)%2↑24)",BPS="12",LBYT="ILDB(LBPT)";
00220 DEFINE LBYTE="((ILDB(LBPT) LSH 24)%2↑24)";
00240 STRING FILI,TFILEI,TFILE,FILEI,OPT0,OPT1,OPT2,OPT3;
00250 INTERNAL INTEGER ARRAY DATBUF[0:BUFSIZ];
00260 INTEGER ARRAY LFILE[0:'177];
00270 INTERNAL REAL ARRAY A,B,C[0:256];
00280 REAL X,SX;
00290 INTEGER XX,YY,ZZ;
00300 INTEGER ARRAY D[0:992];
00310 INTEGER CHAN4,CHAN6,EOF,IEOF;
00320 INTEGER BPT,BPTFST,BPTSAV,LBPT,SEGCNT,SEGTOT;
00330 INTEGER H,I,J,K,L;
00340 INTERNAL INTEGER M,N,P,RATE,STEPS,INFLAG,FLAG;
00350 INTERNAL INTEGER SEGC,SEGMRK,SEGSAV,SEGLIM;
00360 INTERNAL INTEGER INTOT,PONY,HINT,UPCNT,TEACH;
00370 INTERNAL INTEGER I1L,I1H,I2L,I2H,I3L,I3H, INL,INH,NZRNG,
00380 FP1L,FP1H,FP2L,FP2H, ILPB,ILPC, IHPB,IHPC ;
00390 INTERNAL INTEGER TFLAG,ZEROF,ZEROC;
00400 LABEL START,LABELA,LABELB,ZZZZ;
00410 STRING READ1,READ2,PREHINT,STEPX,STPMOD;
00420 INTEGER HCOUNT,HINDEX;
00430 STRING RECMOD; INTEGER ARRAY LEV1,LEV2,LEV3,SEG1,SEG2,SEG3[0:30];
00440 INTEGER CON1,CON2,CON3;
00450 INTEGER ARRAY LEVA,SEGA[0:40]; INTEGER LEVS;
00475
00500 PROCEDURE DATDIS(INTEGER ARRAY A; INTEGER N,XPOS,YPOS;STRING ID);
00510 BEGIN
00520 COMMENT DISPLAYS A HISTOGRAM OF THE FIRST N VALUES
00530 OF ARRAY A AT XPOS,YPOS;
00540 INTEGER I,J,SP;
00550 INTEGER LY,DY;
00560 SP←1024%N; COMMENT HORIZONTAL SPACING;
00570 AIVECT(XPOS,YPOS); RVECT(1023,0);
00580 LY←A[0]/18+YPOS;
00590 AIVECT(XPOS,LY);
00600 FOR I←1 STEP 1 UNTIL N-1 DO
00610 BEGIN
00620 DY←A[I]/18+YPOS-LY;
00630 LY←LY+DY;
00640 RVECT(SP,DY);
00650 END;
00660 AIVECT(XPOS,YPOS-60); DPYSST(ID);
00670 END "DATDIS";
00680
00690 DEFINE ⊂="COMMENT",CR="'15",LF="'12",FF="'14",TB="'11";
00700 DEFINE CRLF="CR&LF", CRLF0="CR&'177&'21"; ⊂ FOR CRLF W/O FORM FEED;
00710 DEFINE TTY="'14",DSK="'13",BDSKO="'12",DPY="'11",BDSKI="'10",TMP="'0";
00720
00730 INTERNAL PROCEDURE LOOKIN(INTEGER CHAN; REFERENCE STRING FILENAME);
00740 BEGIN ⊂ REQUIRES SETBREAK(1,CR,LF,"IN");
00750 BOOLEAN NF;
00760 LOOKUP(CHAN,FILENAME,NF);
00770 WHILE NF DO
00780 BEGIN
00790 OUTSTR(CR&LF&"Can't find "&FILENAME&". File=");
00800 FILENAME ← INPUT(TTY,1);
00810 LOOKUP(CHAN,FILENAME,NF)
00820 END;
00830 END "LOOKIN";
00840
00850 PROCEDURE TELL;
00860 BEGIN
00870 INTEGER TELPPT,TELQPT;
00880 ⊂ To report on the performance of the signature tables;
00890 INTEGER I,J,K,L,HPOINT,MX,IX;
00900 OUTSTR(CRLF&"HINT: "&CVXSTR(PHLIST[H])&TB);
00910 HPOINT←POINT(1,HLIST[H],-1);
00920 FOR I←0 STEP 1 UNTIL 35 DO
00930 IF (K←ILDB(HPOINT))=1 THEN OUTSTR(CVXSTR(FLIST[I])&" ");
00940 OUTSTR(CRLF&"INPUT:"); SETFORMAT(3,0);
00950 FOR I←0 STEP 1 UNTIL 18 DO OUTSTR(CVS(INDAT[I]));
00960 OUTSTR(" "&CVS(ZEROC));
00970 OUTSTR(CRLF&LF&"Table"&TB&"Type"&TB&"Learn"&TB&"Output"&CRLF);
00980 SETFORMAT(1,0);
00990 L←INTOT;
01000 FOR I←INTOT*74 STEP 74 UNTIL TABSIZ DO BEGIN
01010 IF TABLES[I+1]=0 THEN DONE ELSE BEGIN "DECODE"
01020 STRING LEARN; INTEGER K1,K2,K3,K4;
01030 IF LIST[L+LISSIZ%10]≥CVSIX("Q0") THEN BEGIN
01040 K←LIST[L+LISSIZ%5]; K1←K LSH -18; K2←(K LSH 18) LSH -30;
01050 K3←(K LSH 24) LSH -30; K4←(K LSH 30) LSH -30;
01060 LEARN←CVXSTR(PHLIST[K1])[1 TO 2]&CVXSTR(PHLIST[K2])[1 TO 2]&
01070 CVXSTR(PHLIST[K3])[1 TO 2]&CVXSTR(PHLIST[K4])[1 TO 2];
01080 END ELSE LEARN←CVXSTR(LIST[L+LISSIZ%5]);
01090 OUTSTR(CVXSTR(LIST[L])&TB&CVXSTR(LIST[L+LISSIZ%10])&LEARN&TB);
01100 END "DECODE";
01110 OUTSTR(CVS(LDB(POINT(3,TABLES[I],2))));
01120 IF LDB(POINT(1,TABLES[I+1],5))≠0 THEN BEGIN
01130 OUTSTR(TB&CVS(LDB(POINT(3,TABLES[I],5)))&TB&
01140 CVS(LDB(POINT(3,TABLES[I],8)))&TB&CVS(LDB(POINT(3,TABLES[I],11))));
01150 OUTSTR(TB&CVS(LDB(POINT(3,TABLES[I],14)))); L←L+1;I←I+74 END;
01160 OUTSTR(CRLF);
01170 L←L+1;
01180 END;
01190 IF TFLAG≠0 THEN BEGIN L←0;
01200 OUTSTR(CRLF&"Name"&TB&"Input"&TB&"Level"&TB&"Hyst"&TB&"Prob"&TB&
01210 "St.Seg"&TB&"SegCnt"&CRLF);
01220 FOR I←0 STEP 5 UNTIL TBLSIZ DO BEGIN
01230 IF TABLET[I+1]=0 THEN DONE ELSE
01240 IF (LDB(POINT(5,TABLET[I+2],12)))>0 THEN BEGIN "COUNT"
01250 OUTSTR(CVXSTR(TABLET[I+1])&TB&CVXSTR(TBLIS[L])&TB&
01260 CVS(LDB(POINT(3,TABLET[I+2],3)))&TB&
01270 CVS(LDB(POINT(2,TABLET[I+2],5)))&TB&
01280 CVS(LDB(POINT(3,TABLET[I],2)))&TB&
01290 CVS(LDB(POINT(8,TABLET[I],10)))&TB&
01300 CVS(LDB(POINT(7,TABLET[I],17)))&CRLF);
01310 END "COUNT"; L←L+1; END; END;
01320
01330 OPEN(CHAN6,"DSK",0,2,'10,0,0,EOF);
01340 LOOKUP(CHAN6,"TELL.DOC",0);
01350 DEFINE UGETF="'073000000000";
01360 START_CODE;
01370 UGETF 6,I;
01380 END;
01390 ENTER(CHAN6,"TELL.DOC",0);
01400 USETO(CHAN6,I);
01410 SETFORMAT(2,0); OUT(CHAN6,CVS(SEGC)&" "); SETFORMAT(4,0);
01420 FOR I←0 STEP 2 UNTIL 18 DO OUT(CHAN6,CVS(INDAT[I]));
01430 SETFORMAT(2,0); OUT(CHAN6," ");
01440 FOR I←INTOT STEP 1 UNTIL LISSIZ-1 DO BEGIN
01450 IF LIST[I]=0 THEN DONE;
01460 J←I*74;
01470 TELPPT←POINT(3,TABLES[J],2);
01480 ⊂ TELQPT←POINT(3,TABLES[J],17);
01490 IF LIST[I+LISSIZ%10]≥CVSIX("Q0") THEN BEGIN
01500 MX←0; IX←0;
01510 FOR K←1 STEP 1 UNTIL 4 DO BEGIN
01520 L←LDB(POINT(3,TABLES[J],K*3+2));
01530 IF L>MX THEN BEGIN MX←L; IX←K END; END;
01540 IF MX=0 THEN IX←0;
01550
01560 OUT(CHAN6,CVS(MX)); ⊂ IX←MX TEMPORARY ;
01570 I←I+1;
01580 END ELSE
01590 OUT(CHAN6,CVS(LDB(TELPPT)));
01600 END;
01610 OUT(CHAN6,CRLF&" "&CVXSTR(PHLIST[H])[1 TO 3]); SETFORMAT(4,0);
01620 FOR I←1 STEP 2 UNTIL 18 DO OUT(CHAN6,CVS(INDAT[I]));
01630 OUT(CHAN6,CRLF);
01640 IF TFLAG≠0 THEN BEGIN L←0; TFLAG←0;
01650 OUT(CHAN6,CRLF&"Name"&TB&"Input"&TB&"Level"&TB&"Hyst"&TB&
01660 "Prob"&TB&"St.Seg"&TB&"SegCnt"&CRLF);
01670 FOR I←0 STEP 5 UNTIL TBLSIZ DO BEGIN
01680 IF TABLET[I+1]=0 THEN DONE ELSE
01690 IF (LDB(POINT(5,TABLET[I+2],12)))>0 THEN BEGIN "COUNT"
01700 OUT(CHAN6,CVXSTR(TABLET[I+1])&TB&CVXSTR(TBLIS[L])&TB&
01710 CVS(LDB(POINT(3,TABLET[I+2],3)))&TB&
01720 CVS(LDB(POINT(2,TABLET[I+2],5)))&TB&
01730 CVS(LDB(POINT(3,TABLET[I],2)))&TB&
01740 CVS(LDB(POINT(8,TABLET[I],10)))&TB&
01750 CVS(LDB(POINT(7,TABLET[I],17)))&TB&
01760 CRLF);
01770 TABLET[I+2]←TABLET[I+2] LAND '770000000000;
01780 END "COUNT"; L←L+1; END; END;
01790 CLOSE(CHAN6);
01800 END "TELL";
01810
01820 STRING PROCEDURE HEADER;
01830 BEGIN STRING H1,H2; INTEGER I,J,K;
01840 IF HCOUNT>0 THEN BEGIN HCOUNT←HCOUNT-1; RETURN(PREHINT) END
01850 ELSE WHILE HCOUNT=0 DO BEGIN "XXX"
01860 I←LFILE[HINDEX]; K←LDB(POINT(7,I,30)); J←SEGC-K;
01870
01880 IF I=0 THEN BEGIN PREHINT←""; HCOUNT←99; RETURN(PREHINT) END;
01890 IF J ≥ 0 THEN BEGIN "LATCH"
01900 H1←CVXSTR(LDB(POINT(12,I,11)) LSH 24);
01910 H2←CVXSTR(LDB(POINT(12,I,23)) LSH 24);
01920 IF EQU(H1,H2) THEN BEGIN PREHINT←H1; HCOUNT←LDB(POINT(5,I,35));
01930 HCOUNT←HCOUNT-J; HINDEX←HINDEX+1; RETURN(PREHINT); DONE
01940 END ELSE BEGIN PREHINT←""; HCOUNT←LDB(POINT(5,I,35));
01950 HCOUNT←HCOUNT-J; HINDEX←HINDEX+1; RETURN(PREHINT); DONE;
01960 END; END "LATCH";
01970 PREHINT←""; RETURN(PREHINT); END "XXX";
01980 END "HEADER";
01990
02000 PROCEDURE REPORT;
02010 BEGIN "REP"
02020 STRING LAB; INTEGER OUT,I,J,K,L;
02030 IF TFLAG≠0 THEN BEGIN
02040 TFLAG←0;
02050 FOR I←0 STEP 5 UNTIL TBLSIZ DO BEGIN
02060 IF TABLET[I+1]=0 THEN DONE ELSE
02070 IF (LDB(POINT(5,TABLET[I+2],12)))>0 THEN BEGIN "CT"
02080 LAB←CVXSTR(TABLET[I+1]);
02090 OUT←LDB(POINT(18,TABLET[I],17)) LSH 18 ;
02100 IF EQU(LAB,"VOI-C ")∨EQU(LAB,"FRI-C ") THEN
02110 BEGIN LEV1[CON1]←TABLET[I+1];
02120 SEG1[CON1]←OUT; CON1←CON1+1; END
02130 ELSE IF EQU(LAB,"VOWEL ")∨EQU(LAB,"GLIDE ")∨EQU(LAB,"NASAL ")
02140 ∨EQU(LAB,"BURST ")∨EQU(LAB,"STOP ")∨EQU(LAB,"NASGLI") THEN
02150 BEGIN LEV2[CON2]←TABLET[I+1];
02160 SEG2[CON2]←OUT; CON2←CON2+1; END
02170 ELSE BEGIN LEV3[CON3]←TABLET[I+1];
02180 SEG3[CON3]←OUT; CON3←CON3+1; END;
02190 TABLET[I+2]←TABLET[I+2] LAND '770000000000; END "CT"; END; END;
02200 END "REP";
02210
02220 PROCEDURE GRAPH;
02230 BEGIN "GRAFF"
02240 INTEGER I,J,X,Y,Z;
02250 INTEGER ARRAY DPYBUF[0:DPYSIZ];
02260 INTEGER ARRAY NAME[0:40];
02270 TYPLOC(-250,-511);
02280 FOR I←0 STEP 1 UNTIL 40 DO NAME[I]←0;
02290 DPYSET(DPYBUF);
02300 AIVECT(-450,480);
02310 FOR I←0 STEP 1 UNTIL 12 DO BEGIN
02320 RVECT(0,-30); RVECT(0,30); RVECT(8,0);
02330 FOR J←0 STEP 1 UNTIL 8 DO BEGIN
02340 RVECT(0,-4); RIVECT(0,4); RVECT(8,0); END; END;
02350 RVECT(0,-30);
02360
02370 FOR I←0 STEP 1 UNTIL 30 DO BEGIN
02380 Z←LEV1[I];
02390 IF Z=0 THEN DONE;
02400 FOR J←0 STEP 1 UNTIL 40 DO BEGIN
02410 IF NAME[J]=0 THEN DONE;
02420 IF NAME[J]=Z THEN DONE;
02430 END;
02440 X←(LDB(POINT(8,SEG1[I],10)))*8-600;
02450 Y←400-25*J;
02460 AIVECT(X,Y);
02470 IF NAME[J]=0 THEN BEGIN NAME[J]←Z; DPYSST(CVXSTR(NAME[J])); END;
02480 AIVECT(X+90,Y); DPYSST(CVS(LDB(POINT(3,SEG1[I],2))));
02490 AIVECT(X+142,Y+5); X←(2+LDB(POINT(7,SEG1[I],17)))*8; RVECT(X,0);
02500 END;
02510
02520 FOR I←0 STEP 1 UNTIL 30 DO BEGIN
02530 Z←LEV2[I];
02540 IF Z=0 THEN DONE;
02550 FOR J←0 STEP 1 UNTIL 40 DO BEGIN
02560 IF NAME[J]=0 THEN DONE;
02570 IF NAME[J]=Z THEN DONE;
02580 END;
02590 X←(LDB(POINT(8,SEG2[I],10)))*8-600;
02600 Y←360-25*J;
02610 AIVECT(X,Y);
02620 IF NAME[J]=0 THEN BEGIN NAME[J]←Z;DPYSST(CVXSTR(NAME[J]));END;
02630 AIVECT(X+90,Y); DPYSST(CVS(LDB(POINT(3,SEG2[I],2))));
02640 AIVECT(X+142,Y+5);X←(2+LDB(POINT(7,SEG2[I],17)))*8;RVECT(X,0);
02650 END;
02660
02670 FOR I←0 STEP 1 UNTIL 30 DO BEGIN
02680 Z←LEV3[I];
02690 IF Z=0 THEN DONE;
02700 FOR J←0 STEP 1 UNTIL 40 DO BEGIN
02710 IF NAME[J]=0 THEN DONE;
02720 IF NAME[J]=Z THEN DONE;
02730 END;
02740 X←(LDB(POINT(8,SEG3[I],10)))*8-600;
02750 Y←320-25*J;
02760 AIVECT(X,Y);
02770 IF NAME[J]=0 THEN BEGIN NAME[J]←Z;DPYSST(CVXSTR(NAME[J]));END;
02780 AIVECT(X+90,Y); DPYSST(CVS(LDB(POINT(3,SEG3[I],2))));
02790 AIVECT(X+142,Y+5); X←(2+LDB(POINT(7,SEG3[I],17)))*8; RVECT(X,0);
02800 END;
02810 DPYOUT(1);
02820 END "GRAFF";
02830
02840 EXTERNAL INTEGER ECOUNT,EVENTS,EVDUR,EVAVE,EVSURE,EVENT2,EVENT3,EVAVE2,EVAVE3;
02850
02860 PROCEDURE EVENT;
02870 BEGIN
02880
02890 INTEGER I,J,K,L,M;
02900
02910 IF ECOUNT≥6 THEN BEGIN
02920 OUTSTR("Length"&TB&"First"&TB&"Level"&TB&"Second"&TB&"Level"
02930 &TB&"Third"&TB&"Level"&CRLF&LF);
02940 FOR M←35 STEP -6 UNTIL 5 DO BEGIN
02950 J←LDB(POINT(6,EVDUR,M));
02960 I←LDB(POINT(6,EVENTS,M)); K←LDB(POINT(6,EVAVE,M));
02970 I←I*5;
02980 OUTSTR(CVS(J)&TB);
02990 IF I=0 THEN OUTSTR("NULL") ELSE OUTSTR(CVXSTR(TABLET[I+1]));
03000 OUTSTR(TB&CVS(K)&TB);
03010 I←LDB(POINT(6,EVENT2,M)); K←LDB(POINT(6,EVAVE2,M));
03020 I←I*5;
03030 IF I≠0 THEN BEGIN
03035 OUTSTR(CVXSTR(TABLET[I+1]));
03040 OUTSTR(TB&CVS(K)&TB);
03050 I←LDB(POINT(6,EVENT3,M)); K←LDB(POINT(6,EVAVE3,M));
03060 I←I*5;
03062 IF I≠0 THEN BEGIN
03063 OUTSTR(CVXSTR(TABLET[I+1]));
03064 OUTSTR(TB&CVS(K));
03065 END; END;
03067 OUTSTR(CRLF); END;
03070 ECOUNT←0; INCHRW;
03080 END;
03090
03100 END "EVENT";
00010 UPCNT←3; FILEI←"INSERT.L0";
00020 OPT1←"N"; OPT2←"N"; OPT3←"0"; M←8; INFLAG←0;
00030 CHAN4←4; CHAN6←6;
00040 TABIN(INTOT);
00050 IF STRIN("Should old TELL.DOC be spooled YorN = ")="Y" THEN BEGIN
00060 OPEN(CHAN6,"DSK",0,2,'10,0,0,EOF);
00070 LOOKUP(CHAN6,"TELL.DOC",0);
00080 RENAME(CHAN6,"TELL.OLD",0,EOF);
00090 CLOSE(CHAN6);
00100 SPOOL("TELL.OLD",GETCHAN,1);
00110 END;
00120
00130 ⊂ **** MAIN ROUTINE STARTS HERE****;
00140 START:
00150 IF (TFILEI←STRIN("DATA FILE("&FILEI&") = "))≠"" THEN FILEI←TFILEI;
00160 OPT2←STRIN("Do you want the display? ");
00170
00180 M←8; N←2↑M; INFLAG←0;
00190
00200 FOR I←0 STEP 5 UNTIL TBLSIZ-5 DO IF TABLET[I+1]=0 THEN DONE
00210 ELSE TABLET[I+2]←TABLET[I+2] LAND '770000000000;
00220 OUTSTR(CRLF&"Do you want TELL ? YorCR = "); OPT1←INCHWL;
00230 FOR I←0 STEP 1 UNTIL 29 DO BEGIN LEV1[I]←LEV2[I]←LEV3[I]←0;
00240 SEG1[I]←SEG2[I]←SEG3[I]←0; END;
00250 CON1←CON2←CON3←0;
00260 CLOSE(CHAN4);
00270 OPEN(CHAN4,"DSK",'10,10,0,0,0,EOF);
00280 LOOKIN(CHAN4,FILEI);
00290 EOF←0; SEGC←0; SEGCNT←0;
00300 ARRYIN(CHAN4,LFILE[0],'200); ⊂ Input header;
00310 SEGTOT←(LFILE[0]*6)%N; RATE←LFILE[2];
00320 OUTSTR(CRLF&"SAM RATE ="&CVS(LFILE[2])&CRLF);
00330 IF RATE=0 THEN RATE←CVD(STRIN("Sampling rate missing. Rate = "));
00340
00350 ⊂ ****Abreviated record kept by TELL in any case****;
00360 OPEN(CHAN6,"DSK",0,2,'10,0,0,EOF);
00370 LOOKUP(CHAN6,"TELL.DOC",0);
00380 DEFINE UGETF="'073000000000";
00390 START_CODE;
00400 UGETF 6,I;
00410 END;
00420 ENTER(CHAN6,"TELL.DOC",0);
00430 USETO(CHAN6,I);
00440 OUT(CHAN6,FF&DATIME&" Data file "&FILEI&" WITH "&CVS(SEGTOT)&
00450 " SEGMENTS."&CRLF&LF);
00460
00470 IF OPT1="Y" THEN BEGIN ⊂ Detailed TELL output;
00480 FOR I←0 STEP 2 UNTIL 18 DO OUT(CHAN6,CVXSTR(INNAM[I])[1 TO 4]);
00490 FOR I←INTOT STEP 2 UNTIL LISSIZ-1 DO BEGIN
00500 IF LIST[I]=0 THEN DONE;
00510 OUT(CHAN6,CVXSTR(LIST[I])[1 TO 3]&" ");
00520 IF LIST[I+LISSIZ%10]≥CVSIX("Q0") THEN I←I+1;
00530 IF LIST[I+1+LISSIZ%10]≥CVSIX("Q0") THEN I←I+1;
00540 END;
00550 OUT(CHAN6,CRLF&" HINT ");
00560 FOR I←1 STEP 2 UNTIL 17 DO OUT(CHAN6,CVXSTR(INNAM[I])[1 TO 4]);
00570 OUT(CHAN6," ");
00580 FOR I←INTOT+1 STEP 2 UNTIL LISSIZ-1 DO BEGIN
00590 IF LIST[I]=0 THEN DONE;
00600 OUT(CHAN6,CVXSTR(LIST[I])[1 TO 3]&" ");
00610 IF LIST[I+LISSIZ%10]≥CVSIX("Q0") THEN I←I+1;
00620 IF LIST[I+1+LISSIZ%10]≥CVSIX("Q0") THEN I←I+1;
00630 END; END;
00640 OUT(CHAN6,CRLF);
00650
00660 DATSHIFT←0;
00670
00680 LABELA: ⊂ Put all outputs into the off state;
00690 FOR I←0 STEP 5 UNTIL TBLSIZ-5 DO
00700 IF TABLET[I+1]≠0 THEN TABLET[I]←'777777777777 ELSE DONE;
00710 CON1←CON2←CON3←0; HINT←H←0; TABLES[2]←HLIST[0];
00720
00730 ARRYIN(CHAN4,DATBUF[0],SEGTOT*4); ⊂ Get data; CLOSE(CHAN4);
00740 BPT←POINT(6,DATBUF[0],-1); HINDEX←21; HCOUNT←0;
00750
00760 FOR SEGC←1 STEP 1 UNTIL SEGTOT DO BEGIN
00770 FOR P←0 STEP 1 UNTIL 23 DO INDAT[P]←ILDB(BPT);
00780 LABELB: SIG(P); IF OPT1="Y" THEN TELL;
00785 EVENT;
00790 REPORT; SETFORMAT(3,0);
00800 IF CON3≥30 THEN BEGIN
00810 OUTSTR(CRLF&"COUNTER SPACE USED UP"); DONE; END;
00820 END;
00830
00840 FOR I←0 STEP 1 UNTIL INSIZ-1 DO INDAT[I]←0;
00850 FOR I←0 STEP 1 UNTIL 4 DO BEGIN SIG(P); REPORT; SEGC←SEGC+1; END;
00860 IF OPT1="Y" THEN TELL;
00865 ECOUNT←6; EVENT;
00870
00880 IF OPT2="Y" THEN BEGIN "DPY" ⊂ Time domain display;
00890 INTEGER ARRAY DPBUF[0:2000]; INTEGER LV,ST,CN,K1,K2,J1,J2;
00900 STRING FILDAT;INTEGER LOWLIM,ST1;
00910 DPYSET(DPBUF); TYPLOC(-250,-510); SEGLIM←90; LOWLIM←0;
00920 FOR I←1 STEP 1 UNTIL 10 DO
00930 IF EQU(".",FILEI[I TO I]) THEN BEGIN FILDAT←FILEI[1 TO I-1];DONE END;
00940 FILDAT←FILDAT&".DAT[1,THO]"; OUTSTR(CRLF&"DATFILE= "&FILDAT&CRLF);
00950 CLOSE(CHAN4);OPEN(CHAN4,"DSK",'10,10,0,0,0,EOF);LOOKIN(CHAN4,FILDAT);
00960 ARRYIN(CHAN4,DATBUF[0],128);
00970 IF DATSHIFT>0 THEN ARRYIN(CHAN4,DATBUF[0],DATSHIFT);
00980 WHILE SEGLIM≠0 DO BEGIN "L3" L←0; WHILE EOF=0 DO BEGIN
00990 ARRYIN(CHAN4,DATBUF[0],DATSIZ);
01000 IF EOF≠0 THEN
01010 BEGIN
01020 J←EOF LAND '777777;
01030 FOR I←J STEP 1 UNTIL DATSIZ-1 DO DATBUF[I]←0;
01040 END;
01050 LBPT←POINT(BPS,DATBUF[0],-1);
01060 FOR I←0 STEP 1 UNTIL 959 DO
01070 BEGIN D[I]←LBYTE;J←ILDB(LBPT);J←ILDB(LBPT);J←ILDB(LBPT);END;
01080 J←400-L*220; DATDIS(D,960,-511,J," "); L←L+1;
01090 IF L*30≥SEGLIM-LOWLIM THEN DONE;
01100 END ;
01110
01120 FOR I←0 STEP 1 UNTIL CON1-1 DO BEGIN
01130 LV←LDB(POINT(3,SEG1[I],2));
01140 ST1←LDB(POINT(8,SEG1[I],10));ST←ST1-LOWLIM;
01150 CN←LDB(POINT(7,SEG1[I],17));
01160 IF (ST≤90)∧(ST>0) THEN BEGIN
01170 J1←ST/30.3333;
01180 J←400-220*J1;
01190 K1←ST-J1*30; K←-511+32*(K1-1); SETFORMAT(1,0);
01200 AIVECT(K,J); AVECT(K,J-110); RIVECT(5,0); DPYSST(CVS(ST1)); END;
01210
01220 ST←ST+CN+2; ST1←ST1+CN+2;
01230 IF (ST≤90)∧(ST>0) THEN BEGIN
01240 J1←ST/30.3333; K1←ST-J1*30; K←-511+32*(K1-1);
01250 J←400-220*J1;
01260 AIVECT(K,J); AVECT(K,J-110); RIVECT(5,0); DPYSST(CVS(ST1));
01270 RIVECT(-10,-20); DPYSST("*"); END;
01280 END;
01290
01300 FOR I←0 STEP 1 UNTIL CON2-1 DO BEGIN
01310 LV←LDB(POINT(3,SEG2[I],2));
01320 ST1←LDB(POINT(8,SEG2[I],10));ST←ST1-LOWLIM;
01330 CN←LDB(POINT(7,SEG2[I],17));
01340 IF (ST≤90)∧(ST>0) THEN BEGIN
01350 J1←ST/30.3333; J←400-220*J1;
01360 K1←ST-J1*30; K←-511+32*(K1-1); SETFORMAT(1,0);
01370 AIVECT(K,J);AVECT(K,J-110);RIVECT(5,0);DPYSST(CVS(ST1));END;
01380 ST←ST+CN+2; ST1←ST1+CN+2;
01390 IF (ST≤90)∧(ST>0) THEN BEGIN
01400 J1←ST/30.3333; K1←ST-J1*30; K←-511+32*(K1-1);
01410 J←400-220*J1;
01420 AIVECT(K,J); AVECT(K,J-110); RIVECT(5,0); DPYSST(CVS(ST1));
01430 RIVECT(-10,-20); DPYSST("*"); END;
01440 END;
01450 FOR I←0 STEP 1 UNTIL CON3-1 DO BEGIN
01460 LV←LDB(POINT(3,SEG3[I],2));
01470 ST1←LDB(POINT(8,SEG3[I],10)); ST←ST1-LOWLIM;
01480 CN←LDB(POINT(7,SEG3[I],17));
01490 IF (ST≤90)∧(ST>0) THEN BEGIN
01500 J1←ST/30.3333; J←400-220*J1;
01510 K1←ST-J1*30; K←-511+32*(K1-1); SETFORMAT(1,0);
01520 AIVECT(K,J);AVECT(K,J-110);RIVECT(5,0);DPYSST(CVS(ST1));END;
01530 ST←ST+CN+2 ; ST1←ST1+CN+2;
01540 IF (ST≤90)∧(ST>0) THEN BEGIN
01550 J1←ST/30.3333; K1←ST-J1*30; K←-511+32*(K1-1);
01560 J←400-220*J1;
01570 AIVECT(K,J);AVECT(K,J-110);RIVECT(5,0);DPYSST(CVS(ST1));
01580 RIVECT(-10,-20); DPYSST("*"); END;
01590 END; DPYOUT(1);
01600
01605 ⊂ **** On line listing of counter outputs ****;
01610 OUTSTR(CRLF&"LEVEL1"&" P"&" S"&" E*"&TB&"LEVEL2"&
01620 " P"&" S"&" E*"&TB&"LEVEL3"&" P"&" S"&" E*");
01630 FOR I←0 STEP 1 UNTIL 20 DO BEGIN SETFORMAT(3,0);
01640 IF LEV1[I]=0 ∧ LEV2[I]=0 ∧ LEV3[I]=0 THEN DONE;
01650 IF I=(8 MOD 9) THEN BEGIN OUTSTR("[Pause]"); INCHRW; END;
01660 J←LDB(POINT(8,SEG1[I],10));
01665 IF LEV1[I]=0 THEN OUTSTR(CRLF&TB&TB) ELSE
01670 OUTSTR(CRLF&CVXSTR(LEV1[I])&CVS(LDB(POINT(3,SEG1[I],2)))&
01680 CVS(J)&CVS(2+J+LDB(POINT(7,SEG1[I],17)))&"*");
01690 J←LDB(POINT(8,SEG2[I],10));
01695 IF LEV2[I]=0 THEN OUTSTR(TB&TB&TB) ELSE
01700 OUTSTR(TB&CVXSTR(LEV2[I])&CVS(LDB(POINT(3,SEG2[I],2)))&
01710 CVS(J)&CVS(2+J+LDB(POINT(7,SEG2[I],17)))&"*");
01720 J←LDB(POINT(8,SEG3[I],10));
01730 OUTSTR(TB&CVXSTR(LEV3[I])&CVS(LDB(POINT(3,SEG3[I],2)))&
01740 CVS(J)&CVS(2+J+LDB(POINT(7,SEG3[I],17)))&"*");
01750 END; IF SEGLIM≥SEGTOT THEN DONE ELSE
01760 BEGIN SEGLIM←SEGTOT;LOWLIM←90; DPYSET(DPBUF);
01770 TYPLOC(-250,-510); END; END "L3";
01780 END "DPY";
01790 OUTSTR(CRLF);
01800
01805 ⊂ **** Off line listing of counter outputs ****;
01810 OUT(CHAN6,CRLF&"Name"&TB&"Prob"&TB&"St.Seg"&TB&"SegCnt"&CRLF);
01820 FOR I←0 STEP 1 UNTIL CON1-1 DO
01830 OUT(CHAN6,CRLF&CVXSTR(LEV1[I])&TB&CVS(LDB(POINT(3,SEG1[I],2)))&TB&
01840 CVS(LDB(POINT(8,SEG1[I],10)))&TB&CVS(LDB(POINT(7,SEG1[I],17))));
01850 OUT(CHAN6,CRLF); FOR I←0 STEP 1 UNTIL CON2-1 DO
01860 OUT(CHAN6,CRLF&CVXSTR(LEV2[I])&TB&CVS(LDB(POINT(3,SEG2[I],2)))&TB&
01870 CVS(LDB(POINT(8,SEG2[I],10)))&TB&CVS(LDB(POINT(7,SEG2[I],17))));
01880 OUT(CHAN6,CRLF); FOR I←0 STEP 1 UNTIL CON3-1 DO
01890 OUT(CHAN6,CRLF&CVXSTR(LEV3[I])&TB&CVS(LDB(POINT(3,SEG3[I],2)))&TB&
01900 CVS(LDB(POINT(8,SEG3[I],10)))&TB&CVS(LDB(POINT(7,SEG3[I],17))));
01910 OUT(CHAN6,CRLF);
01915
01920 IF STRIN("Do you want graphic display? ")="Y" THEN GRAPH;
01925
01930 I←0; ⊂ Rearrange order for printing;
01940 FOR J←0 STEP 1 UNTIL 30 DO
01950 IF LEV1[J]≠0 THEN BEGIN
01960 LEVA[I]←LEV1[J]; SEGA[I]←SEG1[J]; LEV1[J]←0;
01970 FOR K←J+1 STEP 1 UNTIL 30 DO
01980 IF LEV1[K]=LEVA[I] THEN BEGIN
01990 I←I+1; LEVA[I]←LEV1[K]; SEGA[I]←SEG1[K]; LEV1[K]←0; END;
02000 I←I+1; END;
02010 LEVA[I]←CVSIX("ZZZZ"); I←I+1; ⊂ To produce a space;
02020
02025 ⊂ **** Now report graph in TELL.DOC ****;
02030 FOR J←0 STEP 1 UNTIL 30 DO
02040 IF LEV2[J]≠0 THEN BEGIN
02050 LEVA[I]←LEV2[J]; SEGA[I]←SEG2[J]; LEV2[J]←0;
02060 FOR K←J+1 STEP 1 UNTIL 30 DO
02070 IF LEV2[K]=LEVA[I] THEN BEGIN
02080 I←I+1; LEVA[I]←LEV2[K]; SEGA[I]←SEG2[K]; LEV2[K]←0; END;
02090 I←I+1; END;
02100 LEVA[I]←CVSIX("ZZZZ"); I←I+1; ⊂ To produce a space;
02110
02120 FOR J←0 STEP 1 UNTIL 30 DO
02130 IF LEV3[J]≠0 THEN BEGIN
02140 LEVA[I]←LEV3[J]; SEGA[I]←SEG3[J]; LEV3[J]←0;
02150 FOR K←J+1 STEP 1 UNTIL 30 DO
02160 IF LEV3[K]=LEVA[I] THEN BEGIN
02170 I←I+1; LEVA[I]←LEV3[K]; SEGA[I]←SEG3[K]; LEV3[K]←0; END;
02180 I←I+1; END;
02190 LEVA[I]←0; ⊂ Set stop;
02200
02210 LEVS←0; SETFORMAT(1,0); OUT (CHAN6,CRLF&" ");
02220 FOR I←0 STEP 1 UNTIL 9 DO OUT(CHAN6,CVS(I)&" . ");
02230 OUT(CHAN6,CRLF);
02240 FOR I←0 STEP 1 UNTIL 40 DO BEGIN
02250 IF LEVA[I]=0 THEN DONE;
02260 IF LEVA[I]=CVSIX("ZZZZ") THEN BEGIN I←I+1; OUT(CHAN6,CRLF); END;
02270 XX←LDB(POINT(8,SEGA[I],10));
02280 IF LEVA[I]≠LEVS THEN BEGIN LEVS←LEVA[I]; OUT(CHAN6,CRLF);
02290 FOR J←1 STEP 1 UNTIL XX DO OUT(CHAN6," ");
02300 OUT(CHAN6,CVXSTR(LEVS));
02310 END ELSE BEGIN YY←XX-ZZ;
02320 IF YY≥7 THEN BEGIN
02330 FOR J←1 STEP 1 UNTIL YY-6 DO OUT(CHAN6," ");
02340 OUT(CHAN6,CVXSTR(LEVS)); END ELSE
02350 FOR J←1 STEP 1 UNTIL YY DO OUT(CHAN6," "); END;
02360 OUT(CHAN6,CVS(LDB(POINT(3,SEGA[I],2))));
02370 YY←LDB(POINT(7,SEGA[I],17)); ZZ←XX+YY+1;
02380 FOR J←1 STEP 1 UNTIL YY DO OUT(CHAN6,"-");
02390 END; OUT(CHAN6,CRLF); CLOSE(CHAN6);
02400
02410 FOR I←0 STEP 1 UNTIL INSIZ DO
02420 INDAT[I]←0; HINT←H←0; TABLES[2]←HLIST[0]; ⊂ XXXX ;
02430 FOR I←0 STEP 1 UNTIL 6 DO BEGIN SEGC←SEGC+1; SIG(P); REPORT;
02440 IF OPT1="Y" THEN TELL;END;
02450 GO TO START;
02460
02470 END "SHOW";